﻿Imports System.Text.RegularExpressions
Imports System.Threading
Imports System.Net

Public Class spider

    Private conn As New OleDb.OleDbConnection
    Private comm As New OleDb.OleDbCommand

    Public Sub Initdb()
        Dim dbpath As String = Application.StartupPath + "\" + "myurl.mdb"
        Dim commstr As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath & ";Persist Security Info=False"
        conn = New OleDb.OleDbConnection(commstr)
        comm = New OleDb.OleDbCommand()
        comm.Connection = conn

    End Sub

    Private Function Saveurl(ByVal url As String)
        conn.Open()
        comm.CommandText = "select count(*) from myurl where url='" & url.Trim() & "' "
        If comm.ExecuteScalar() <= 0 Then
            Dim comstr As String = "insert into myurl(url,status,addtime)values('" & url.Trim() & "','0',now())"
            comm.CommandText = comstr
            comm.ExecuteNonQuery()
        End If
        conn.Close()
    End Function




    Dim webc As New GetWebPage()
    Private Sub btnspider_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnspider.Click
        btnspider.Enabled = False

        Dim htmlcode As String = webc.HttpGet(txt_url.Text, "", "")
        ExtraUri(htmlcode)

      
        While (Me.queueURLS.Count > 0)



            Dim worker As Thread = New Thread(New ThreadStart(AddressOf ThreadRunFunction))
            worker.Name = "worker"
            worker.Start()
            Application.DoEvents()
            Thread.Sleep(5000)

        End While

        MessageBox.Show("done")

        btnspider.Enabled = True

    End Sub

    Private Function DequeueUri() As MyUri
        Monitor.Enter(Me.queueURLS)
        Dim uri As MyUri = Nothing
        Try
            uri = DirectCast(Me.queueURLS.Dequeue, MyUri)
            Debug.WriteLine("uri=" + uri.ToString)
        Catch exception1 As Exception
            Debug.WriteLine(exception1.Message)
        End Try
        Monitor.Exit(Me.queueURLS)
        Return uri
    End Function







    Private Sub ThreadRunFunction()


        Dim uri As MyUri = Me.DequeueUri
        If (IsNothing(uri)) Then
            Application.ExitThread()
            Return
        End If
        If (String.IsNullOrEmpty(uri.ToString)) Then
            Application.Exit() 
            Return
        End If


        If (Not uri Is Nothing) Then
            Thread.Sleep(1000)
            Dim htmlcode As String = webc.HttpGet(uri.ToString, "", "")
            ExtraUri(htmlcode)
        Else
            Thread.Sleep(30)
        End If


    End Sub


    Public Sub ExtraUri(ByVal webcode As String)

        If (String.IsNullOrEmpty(webcode)) Then
            Return
        End If

        '  Dim strRef As String = "(href|HREF|src|SRC)[ ]*=[ ]*[""'][^""'#>]+[""']"
        Dim strRef As String = "href=[^@#?(rev)]{3,36}(com|net|biz|cc|cn|info|org|tv|tel|mobi|me)"
        Dim matches As MatchCollection = New Regex(strRef).Matches(webcode)
       
        Dim match As Match
        For Each match In matches
            Dim urls As String = match.Value
            urls = urls.Replace("href=", "")
            urls = urls.Replace("""", "")
            urls = urls.Replace("'", "")
            Try
                If Not (((urls.IndexOf("..") = -1) AndAlso Not urls.StartsWith("/")) AndAlso urls.StartsWith("http://")) Then
                    urls = New Uri(urls).AbsoluteUri
                End If
                Normalize(urls)
                Dim newUri As New MyUri(urls)
                EnqueueUri(newUri)
            Catch exception2 As Exception
                Debug.WriteLine(exception2.Message + urls)
            End Try


        Next
    End Sub

    Private Sub Normalize(ByRef strURL As String)
        If Not strURL.StartsWith("http://") Then
            strURL = ("http://" & strURL)
        End If
        If (strURL.IndexOf("/", 8) = -1) Then
            strURL = (strURL & "/"c)
        End If
    End Sub

    Private queueURLS As New Queue


    Private Function EnqueueUri(ByVal uri As MyUri) As Boolean
        If AddURL(uri) = False Then
            Return False
        End If

        Try
            Me.queueURLS.Enqueue(uri)
            Saveurl(uri.ToString)
            Debug.WriteLine(uri.ToString)
        Catch exception1 As Exception
            Debug.WriteLine(exception1.Message)
        End Try

        Return True
    End Function

    Private urlStorage As New Hashtable


    Private Function AddURL(ByRef uri As MyUri) As Boolean
     
        Dim strURL As String = uri.AbsoluteUri
        If (urlStorage.ContainsKey(strURL)) Then
            Return False
        Else
            urlStorage.Add(strURL, strURL)
            Return True
        End If

    End Function








    Private Sub spider_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Initdb()
    End Sub
End Class